home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / dycp.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-14  |  2KB  |  114 lines
  1.  
  2. {$g+}
  3. program different_y_char_position;
  4. { Slow DYCP, by Bas van Gaalen, Holland, PD }
  5. uses crt;
  6. const vseg : word = $a000; txt : string = 'Howdy folks, this is a DYCP';
  7. var stab : array[0..255] of byte; fseg,fofs : word;
  8.  
  9. procedure getfont; assembler; asm
  10.   mov ax,1130h; mov bh,1; int 10h; mov fseg,es; mov fofs,bp; end;
  11.  
  12. procedure csin; var i : byte; begin
  13.   for i := 0 to 255 do stab[i] := round(sin(6*i*pi/255)*25)+150; end;
  14.  
  15. {procedure writechar(ch : char; x,y : word; col : byte);
  16. var i,j,k : byte;
  17. begin
  18.   for j := 0 to 7 do
  19.     for k := 0 to 7 do
  20.       if ((mem[fseg:fofs+ord(ch)*8+j] shl k) and 128) <> 0 then
  21.         mem[$a000:(y+j)*320+x+k] := col;
  22. end;}
  23.  
  24. procedure writecharasm(c : char; x,y : word; col : byte); assembler;
  25. asm
  26.   push ds
  27.   mov es,vseg
  28.   mov dx,0         { j }
  29.  @lout:
  30.   mov ax,y         { y+j }
  31.   add ax,dx
  32.   shl ax,6         { *320 }
  33.   mov bx,ax
  34.   shl ax,2
  35.   add bx,ax
  36.   add bx,x         { +x }
  37.   mov cx,0         { k }
  38.  @lin:
  39.   mov ax,0c000h
  40.   mov ds,ax        { fseg }
  41.   mov si,420ah     { fofs }
  42.   xor ah,ah
  43.   mov al,c         { ord(c) }
  44.   shl ax,3         { *8 }
  45.   add si,ax
  46.   add si,dx        { +j }
  47.   xor ah,ah
  48.   mov al,[ds:si]
  49.   shl al,cl        { shl k }
  50.   and al,80h       { and 128 }
  51.   cmp al,0         { <> 0 ? }
  52.   je @skip
  53.   mov di,bx
  54.   add di,cx        { +k }
  55.   mov al,col
  56.   mov [es:di],al   { mem[seg:ofs] := col }
  57.  @skip:
  58.   inc cx
  59.   cmp cx,8
  60.   jne @lin
  61.   inc dx
  62.   cmp dx,8
  63.   jne @lout
  64.   pop ds
  65. end;
  66.  
  67. procedure clear(x,y : word); assembler;
  68. asm
  69.   mov es,vseg
  70.   mov dx,0
  71.  @lout:
  72.   mov cx,0
  73.  @lin:
  74.   mov ax,y
  75.   add ax,dx
  76.   shl ax,6
  77.   mov di,ax
  78.   shl ax,2
  79.   add di,ax
  80.   add di,x
  81.   add di,cx
  82.   xor ax,ax
  83.   mov [es:di],ax
  84.   add cx,2
  85.   cmp cx,8
  86.   jne @lin
  87.   inc dx
  88.   cmp dx,8
  89.   jne @lout
  90. end;
  91.  
  92. procedure dodycp;
  93. var sctr,i : byte;
  94. begin
  95.   sctr := 0;
  96.   repeat
  97.     while (port[$3da] and 8) <> 0 do;
  98.     while (port[$3da] and 8) = 0 do;
  99.     for i := 1 to length(txt) do
  100.       clear(40+i*8,stab[(sctr-1+2*i) mod 255]);
  101.     for i := 1 to length(txt) do
  102.       writecharasm(txt[i],40+i*8,stab[(sctr+2*i) mod 255],7);
  103.     inc(sctr);
  104.   until keypressed;
  105. end;
  106.  
  107. begin
  108.   getfont;
  109.   csin;
  110.   asm mov ax,13h; int 10h; end;
  111.   dodycp;
  112.   textmode(lastmode);
  113. end.
  114.